home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok59.lha / AmokEd_V1.02b / txt / EdRexx.mod < prev    next >
Text File  |  1993-08-15  |  14KB  |  476 lines
  1. (****************************************************************************
  2.  
  3. :Program.    EdRexx.mod
  4. :Contents.   Rexx- and Applications-Interface for AmokEd
  5. :Author.     Hartmut Goebel
  6. :Language.   Oberon
  7. :Translator. AmigaOberon V2.00
  8. :Imports.    Printf (Volker Rudolph)
  9. :History.    V0.1, 3 Dec 1990, Hartmut Goebel
  10. :History.    V1.0, 14 Apr 1991 Hartmut Goebel [hG]
  11. :History.    V1.0b 19 Apr 1991 [hG] Portname enthält Adresse => eindeutig
  12. :History.    V1.1  20 Apr 1991 [hG] + Applications
  13. :History.    V1.1b 18 Jun 1991 [hG] Typedefs taken from Rexx.mod
  14. :History.    V1.2  16 Oct 1991 [hG] +GetVal, revised doRexx
  15. :Date.       19 Oct 1991 03:44:06
  16.  
  17. ****************************************************************************)
  18.  
  19. MODULE EdRexx;
  20.  
  21. IMPORT
  22.   Printf,
  23.   d  : Dos,
  24.   e  : Exec,
  25.   es : ExecSupport,
  26.   eAD: EdApplDefs,
  27.   edD: EdDisplay,
  28.   edE: EdErrors,
  29.   edG: EdGlobalVars,
  30.   edL: EdLowLevel,
  31.   lst: EdLists,
  32.   ol : OberonLib,
  33.   rx : Rexx, (* only Type Defs *)
  34.   str: Strings,
  35.   s  : SYSTEM;
  36.  
  37. CONST
  38.   (*CallingARexxMacro = "Calling ARexx Macro ...";*)
  39.   UnknownCommand = "Unknown Command";
  40.   NoMacrosARexxNotActive = "Unknown Command -- No Macros: ARexx Not Active";
  41.   CreateRexxMsgFailed = "CreateRexxMsg() Failed";
  42.   FillRexxMsgFailed = "FillRexxMsg() Failed";
  43.   ApplicationNotFound = "Application not found";
  44.   (*RemoteError = "Remote error";*)
  45.   (*ARexxMacroExecHalted = "ARexx Macro Execution Halted";*)
  46.   ARexxMacroError = "ARexx Macro Error: Code = %ld Severity = %ld";
  47.   UserSpecifiedMacroError = "User Specified Macro Error: RC = %ld";
  48.   ApplAlreadyIncluded = "Application already included";
  49.  
  50.   REXX = "REXX"; (* send to ARexx-Port "REXX" *)
  51.  
  52. CONST
  53.   (* Command *)
  54.   comm* = 1;
  55.   func* = 2;
  56.   close* = 3;
  57.   query* = 4;
  58.   addFH* = 7;
  59.   addLib* = 8;
  60.   remLib* = 9;
  61.   addCon* = 10;
  62.   remCon* = 11;
  63.   tcOpn* = 12;
  64.   tcCls* = 13;
  65.  
  66.   (* ModifierFlags *)
  67.   noIO* = 0;
  68.   result* = 1;
  69.   moString* = 2;
  70.   token* = 3;
  71.   nonRet* = 4;
  72.  
  73. TYPE
  74.   ActionRec* = STRUCT
  75.     command* : SHORTINT;
  76.     modifier* : SHORTSET;
  77.     add* : INTEGER; (* eigentlich CARDINAL *)
  78.   END;
  79.  
  80.   RexxMsgPtr* = POINTER TO RexxMsg;
  81.   RexxMsg * = STRUCT (node * : e.Message)
  82.     taskBlock * : e.APTR;
  83.     libBase * : e.LibraryPtr;
  84.     action* : ActionRec;
  85.     result1 * : LONGINT;
  86.     result2 * : LONGINT;
  87.     args * : ARRAY 16 OF e.STRPTR;
  88.     passPort * : e.MsgPortPtr;
  89.     commAddr * : e.STRPTR;
  90.     fileExt * : e.STRPTR;
  91.     stdin * : d.FileHandlePtr;
  92.     stdout * : d.FileHandlePtr;
  93.     avail * : LONGINT;
  94.   END;
  95.  
  96. VAR
  97.   rxs: e.LibraryPtr;
  98.  
  99. VAR
  100.   RxPort*: e.MsgPortPtr;
  101.   CmdMsg*: RexxMsgPtr;   (* the incomming Msg *)
  102.   ApplArgCnt*: INTEGER;
  103.   RxPortSigBit*: LONGINT;
  104.   Buffer: edG.String;
  105.   ErrTitle: ARRAY 60 OF CHAR; (* für Fehlermeldungen *)
  106.   ApplList: lst.List;
  107.  
  108. TYPE
  109.   ApplPtr = POINTER TO Application;
  110.   Application = STRUCT (node: lst.Node)
  111.     name: edG.StringPtr;
  112.     port: edG.StringPtr;
  113.   END;
  114.  
  115. CONST
  116.   Extension = "aed";
  117.  
  118. (*------------------------------------------------------------------*)
  119.  
  120. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  121.  
  122. PROCEDURE ClearRexxMsg{rxs,-156}(msgPtr{8}: RexxMsgPtr;
  123.                                  count{0}:  LONGINT);
  124. PROCEDURE CreateArgstring{rxs,-126}(string{8}: LONGINT;
  125.                                     length{0}: LONGINT): LONGINT;
  126. PROCEDURE CreateRexxMsg{rxs,-144}(replyPort{8}: e.MsgPortPtr;
  127.                                   extension{9}:  ARRAY OF CHAR;
  128.                                   host{0}:       ARRAY OF CHAR): RexxMsgPtr;
  129. PROCEDURE DeleteArgstring{rxs,-132}(argstring{8}: LONGINT);
  130. PROCEDURE DeleteRexxMsg{rxs,-150}(packet{8}: RexxMsgPtr);
  131. PROCEDURE FillRexxMsg{rxs,-162}(msgPtr{8}: RexxMsgPtr;
  132.                                 count{0}:  LONGINT;
  133.                                 mask{1}:   SET): BOOLEAN;
  134. PROCEDURE FreePort{rxs,-234}(port{8}: e.MsgPortPtr);
  135. PROCEDURE InitPort{rxs,-228}(port{8}: e.MsgPortPtr;
  136.                              name{9}: ARRAY OF CHAR): LONGINT;
  137. PROCEDURE IsRexxMsg*{rxs,-168}(msgPtr{8}: e.MessagePtr): BOOLEAN;
  138.  
  139. (* $OvflChk= $RangeChk= $StackChk- $NilChk= $ReturnChk= $CaseChk= *)
  140.  
  141. (*------------------------------------------------------------------*)
  142.  
  143. PROCEDURE IsApplMsg*(msg{8}: RexxMsgPtr): BOOLEAN;
  144. BEGIN
  145.   IF msg.node.node.name = eAD.idAEd1 THEN
  146.     INCL(edG.Status,edG.isAppl); RETURN TRUE;
  147.   ELSIF msg.node.node.name = eAD.idAEd0 THEN
  148.     edG.Status := edG.Status - LONGSET{edG.isAppl} + LONGSET{edG.isRexx};
  149.     RETURN TRUE;
  150.   ELSE
  151.     edG.Status := edG.Status - LONGSET{edG.isAppl,edG.isRexx};
  152.     RETURN FALSE;
  153.   END;
  154. END IsApplMsg;
  155.  
  156.  
  157. PROCEDURE doRexx*(modifier: SHORTSET; port: edG.StringPtr; argo: e.ADDRESS);
  158. VAR
  159.   RxMsg: RexxMsgPtr;
  160.   rxArg: rx.RexxArgPtr;
  161.   ARexxPort: e.MsgPortPtr;
  162.   oldTxt: edG.TextHeaderPtr;
  163.   oldlock: d.FileLockPtr;
  164.   cmd, buffer, aux: edG.StringPtr;
  165.   help: ARRAY 8 OF CHAR;
  166.   status: LONGSET;
  167.   argCnt: INTEGER;
  168. BEGIN
  169.   IF NOT (edG.arexxAvail IN edG.Status) THEN
  170.     edL.Title(NoMacrosARexxNotActive); edG.Rc := edE.cmdFailed;
  171.     RETURN;
  172.   END;
  173.   RxMsg := CreateRexxMsg(RxPort,Extension,edG.AEdrxPort);
  174.   IF (RxMsg = NIL) AND (edG.Text # NIL) THEN
  175.     edL.Title(CreateRexxMsgFailed); edG.Rc := edE.cmdSevere;
  176.     RETURN;
  177.   END;
  178.   RxMsg.args[0] := argo;
  179.   (*
  180.    * from now on we use argo temporary
  181.    *)
  182.   RxMsg.args[eAD.TextSlot] := s.VAL(LONGINT,edG.Text);
  183.   IF argo = NIL THEN
  184.     RxMsg.action.command := close;
  185.   ELSE
  186.     IF NOT FillRexxMsg(RxMsg,1,{}) AND (edG.Text # NIL) THEN
  187.       (*
  188.        * wandelt gleich in Argstrings
  189.        *)
  190.       edL.Title(FillRexxMsgFailed); edG.Rc := edE.cmdSevere;
  191.       DeleteRexxMsg(RxMsg);
  192.       RETURN;
  193.     END;
  194.     RxMsg.action.command := comm;
  195.   END;
  196.   RxMsg.node.node.name := eAD.idAEd0;
  197.   RxMsg.action.modifier := modifier-SHORTSET{result};
  198.   oldTxt := NIL;
  199.   IF edG.Text # NIL THEN
  200.     oldlock := d.CurrentDir(edG.Text.dirLock);
  201.     EXCL(edG.Text.status,edG.keepTitle);
  202.   END;
  203.   e.Forbid;
  204.   ARexxPort := e.FindPort(port^);
  205.   IF ARexxPort # NIL THEN
  206.     e.PutMsg(ARexxPort,RxMsg);
  207.     e.Permit;
  208.  
  209.     (*edL.Title(CallingARexxMacro);*)
  210.     LOOP
  211.       e.WaitPort(RxPort);
  212.       CmdMsg := e.GetMsg(RxPort);
  213.  
  214.       IF RxMsg = CmdMsg THEN EXIT; END; (* eigene Msg zurück -> fertig *)
  215.  
  216.       IF edG.Text # NIL THEN
  217.         IF IsRexxMsg(CmdMsg) OR IsApplMsg(CmdMsg) THEN
  218.           IF IsApplMsg(CmdMsg) AND (CmdMsg.args[eAD.TextSlot] # NIL)
  219.           AND (edG.Text # s.VAL(LONGINT,CmdMsg.args[eAD.TextSlot]))
  220.           AND lst.IsElement(edG.EditList,
  221.                             s.VAL(LONGINT,CmdMsg.args[eAD.TextSlot]))
  222.           THEN
  223.             IF oldTxt=NIL THEN oldTxt := edG.Text END;
  224.             edD.SwitchEdit(s.VAL(LONGINT,CmdMsg.args[eAD.TextSlot]));
  225.           END;
  226.  
  227.           EXCL(edG.Status,edG.cmdFound); (* neues Spiel, neues Glück *)
  228.           edG.Rc := edE.cmdInitial;
  229.           CmdMsg.result2 := edE.noError;
  230.           ApplArgCnt := 0;
  231.  
  232.           COPY(CmdMsg.args[0]^,help); help[7] := 0X;
  233.           IF (result IN CmdMsg.action.modifier)
  234.           AND (edL.NCStrCmp(s.ADR(help),s.ADR("GETVAL ")) = 0) THEN
  235.             INCL(edG.Status,edG.cmdFound);
  236.             IF edG.isAppl IN edG.Status THEN
  237.               EXCL(edG.Status,edG.isAppl); (* so BreakOut works correctly *)
  238.               buffer := edL.CopyString(s.VAL(LONGINT,CmdMsg.args[1]));
  239.             ELSE
  240.               buffer := edL.CopyString(s.VAL(LONGINT,CmdMsg.args[0])+7);
  241.             END;
  242.             IF buffer # NIL THEN
  243.               argo := buffer;
  244.               cmd := edG.BreakOut(buffer,aux);
  245.               IF cmd # NIL THEN
  246.                 CmdMsg.result2 := CreateArgstring(cmd,str.Length(cmd^)); END;
  247.               IF aux # NIL THEN DISPOSE(aux); END;
  248.               DISPOSE(argo);
  249.             END;
  250.           ELSE
  251.             argo := CmdMsg;         (* sichern *)
  252.             status := edG.Status * LONGSET{edG.isAppl,edG.isRexx};
  253.             argCnt := ApplArgCnt;
  254.             edG.ExecCmd(s.VAL(LONGINT,CmdMsg.args[0]));
  255.             CmdMsg := argo;         (* zurückschreiben *)
  256.             edG.Status := edG.Status + status; ApplArgCnt := argCnt;
  257.           END;
  258.  
  259.           IF NOT (edG.cmdFound IN edG.Status) THEN
  260.             edG.Rc := edE.rxFailed;
  261.             CmdMsg.result2 := edE.cmdNotFound;
  262.           ELSIF edG.Rc < edE.FailLevel THEN
  263.             edG.Rc := edE.cmdValid0;
  264.           ELSE
  265.             CmdMsg.result2 := edG.ErrorCode;
  266.           END;
  267.           CmdMsg.result1 := edG.Rc;
  268.         END; (* IF IsRexxMsg OR IsApplMsg *)
  269.       END; (* edG.Text # NIL *)
  270.       e.ReplyMsg(CmdMsg);
  271.     END; (* LOOP *)
  272.  
  273.     IF edG.Text # NIL THEN
  274.       IF oldTxt # NIL THEN edD.SwitchEdit(oldTxt); END;
  275.       INCL(edG.Status,edG.cmdFound);
  276.       IF edG.keepTitle IN edG.Text.status THEN
  277.         edG.Rc := edE.cmdValid2;
  278.       ELSIF (CmdMsg.result1 # 0) AND (edG.Rc = CmdMsg.result1) THEN
  279.         IF CmdMsg.result1 = 1 THEN
  280.            EXCL(edG.Status,edG.cmdFound);
  281.            edL.Title(UnknownCommand);
  282.         ELSE
  283.           Printf.SPrintf2(ErrTitle,ARexxMacroError,
  284.                           CmdMsg.result2,CmdMsg.result1);
  285.           edL.Title(ErrTitle);
  286.         END;
  287.       ELSIF CmdMsg.result2 # 0 THEN
  288.         Printf.SPrintf1(ErrTitle,UserSpecifiedMacroError,CmdMsg.result2);
  289.         edL.Title(ErrTitle); edG.Rc := edE.cmdFailed;
  290.       END; (* IF CmdMsg.result1 # 0 *)
  291.     END; (* edG.Text # NIL *)
  292.   ELSE  (* IF ARexxPort#NIL *)
  293.     e.Permit;
  294.     IF edG.Text # NIL THEN
  295.       edL.Title(NoMacrosARexxNotActive); END;
  296.     edG.Rc := edE.cmdError;
  297.   END;
  298.   IF edG.Text # NIL THEN
  299.     oldlock := d.CurrentDir(oldlock); END;
  300.   ClearRexxMsg(RxMsg,1);
  301.   DeleteRexxMsg(RxMsg);
  302.   edG.Status := edG.Status - LONGSET{edG.isAppl,edG.isRexx};
  303. END doRexx;
  304.  
  305.  
  306. PROCEDURE doRx*;
  307. BEGIN
  308.   IF moString IN edG.ArgSet THEN
  309.     doRexx(SHORTSET{moString},s.ADR(REXX),edG.Arg[0]);
  310.   ELSE
  311.     doRexx(SHORTSET{},s.ADR(REXX),edG.Arg[0]);
  312.   END;
  313. END doRx;
  314.  
  315. (*
  316.  *  doRex1 is also used as implicit invocation interface between
  317.  *  doCommand() and doRexx for ARexx macros implicitly called;
  318.  *  arbitrary number of arguments
  319.  *)
  320.  
  321. PROCEDURE doRx1*;
  322. BEGIN
  323.   Printf.SPrintf2(Buffer,"%s %s",edG.Arg[0],edG.Arg[1]);
  324.   doRexx(SHORTSET{},s.ADR(REXX),s.ADR(Buffer));
  325. END doRx1;
  326.  
  327.  
  328. PROCEDURE doRx2*;
  329. BEGIN
  330.   Printf.SPrintf3(Buffer,"%s %s %s",edG.Arg[0],edG.Arg[1],edG.Arg[2]);
  331.   doRexx(SHORTSET{},s.ADR(REXX),s.ADR(Buffer));
  332. END doRx2;
  333.  
  334. (* -------------------------------------------------------------------------*)
  335.  
  336. PROCEDURE FindApplNode(name: edG.StringPtr): ApplPtr;
  337. VAR
  338.   appl: lst.NodePtr;
  339. BEGIN
  340.   appl := ApplList.head;
  341.   WHILE appl # NIL DO
  342.     IF edL.NCStrCmp(appl(Application).name,name) = 0 THEN
  343.       RETURN appl(Application); END;
  344.     appl := appl.next;
  345.   END;
  346.   RETURN NIL;
  347. END FindApplNode;
  348.  
  349.  
  350. PROCEDURE GetApplPort*(find: edG.StringPtr): edG.StringPtr;
  351. VAR
  352.   appl: ApplPtr;
  353. BEGIN
  354.   appl := FindApplNode(find);
  355.   IF appl # NIL THEN RETURN appl.port ELSE RETURN NIL END;
  356. END GetApplPort;
  357.  
  358.  
  359. PROCEDURE ReleaseAppl(appl: ApplPtr);
  360. BEGIN
  361.   lst.Remove(ApplList,appl);
  362.   (* DISPOSE(appl.port); DISPOSE(appl.name); *)
  363.   DISPOSE(appl); (* wurde ja am Stück alloziert!! *)
  364. END ReleaseAppl;
  365.  
  366.  
  367. PROCEDURE doApplAdd*;
  368. VAR
  369.   appl: ApplPtr;
  370.   len0, len1: INTEGER;
  371. BEGIN
  372.   IF FindApplNode(edG.Arg[0]) # NIL THEN
  373.     edL.Title(ApplAlreadyIncluded); edG.Rc := edE.cmdFailed;
  374.     RETURN;
  375.   END;
  376.   len0 := str.Length(edG.Arg[0]^)+1;
  377.   len1 := str.Length(edG.Arg[1]^)+1;
  378.   ol.New(appl,s.SIZE(Application)+len0+len1);
  379.   IF appl=NIL THEN
  380.     INCL(edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
  381.     RETURN;
  382.   END;
  383.   (* s.INIT(appl); STRUCT!! *)
  384.   appl.name := s.VAL(LONGINT,appl)+s.SIZE(Application);
  385.   appl.port := s.VAL(LONGINT,appl.name)+len0;
  386.   e.CopyMem(edG.Arg[0]^,appl.name^,len0);
  387.   e.CopyMem(edG.Arg[1]^,appl.port^,len1);
  388.   lst.AddTail(ApplList,appl);
  389.   Printf.SPrintf1(Buffer,"Appl installed: %s",edG.Arg[0]);
  390.   edL.Title(Buffer); edG.Rc := edE.cmdValid2;
  391. END doApplAdd;
  392.  
  393.  
  394. PROCEDURE doApplClose*;
  395. VAR
  396.   appl: ApplPtr;
  397. BEGIN
  398.   appl := FindApplNode(edG.Arg[0]);
  399.   IF appl#NIL THEN
  400.     doRexx(SHORTSET{},appl.port,NIL);
  401.     ReleaseAppl(appl);
  402.   END;
  403. END doApplClose;
  404.  
  405. (*
  406.  *  doAppl is also used as implicit invocation interface between
  407.  *  doCommand() and doRexx for Applications implicitly called;
  408.  *  arbitrary number of arguments
  409.  *)
  410.  
  411. PROCEDURE doAppl*;
  412. VAR
  413.   appl: ApplPtr;
  414. BEGIN
  415.   appl := FindApplNode(edG.Arg[0]);
  416.   IF appl#NIL THEN
  417.     doRexx(SHORTSET{},appl.port,edG.Arg[1]);
  418.   ELSE
  419.     edL.Title(ApplicationNotFound); edG.Rc := edE.cmdFailed;
  420.   END;
  421. END doAppl;
  422.  
  423. (*--------------------------------------------------------------------------*)
  424.  
  425. PROCEDURE OpenRexx():BOOLEAN;
  426. BEGIN
  427.   rxs := e.OpenLibrary(rx.rxsName,34);
  428.   IF rxs = NIL THEN RETURN FALSE; END;
  429.  
  430.   (*
  431.   Printf.SPrintf1(edG.AEdrxPort,"AEd%08lx",e.FindTask(NIL));
  432.   RxPort := es.CreatePort(edG.AEdrxPort,0);
  433.   IF RxPort = NIL THEN RETURN FALSE; END;
  434.   *)
  435.   NEW(RxPort);
  436.   IF RxPort = NIL THEN RETURN FALSE; END;
  437.   Printf.SPrintf1(edG.AEdrxPort,"AEd%08lx",RxPort);
  438.   RxPortSigBit := InitPort(RxPort,edG.AEdrxPort);
  439.   IF RxPortSigBit = -1 THEN RETURN FALSE; END;
  440.   e.AddPort(RxPort);
  441.   INCL(edG.Status,edG.arexxAvail);
  442.   RETURN TRUE;
  443. END OpenRexx;
  444.  
  445.  
  446. PROCEDURE CloseRexx;
  447. BEGIN
  448.   IF RxPort # NIL THEN
  449.     IF RxPortSigBit # -1 THEN
  450.       e.RemPort(RxPort); END;
  451.     (*
  452.     edL.DeletePort(RxPort);
  453.     *)
  454.     FreePort(RxPort);
  455.     DISPOSE(RxPort);
  456.   END;
  457.   edG.AEdrxPort := "";
  458.   IF rxs # NIL THEN e.CloseLibrary(rxs); END;
  459.   EXCL(edG.Status,edG.arexxAvail);
  460. END CloseRexx;
  461.  
  462.  
  463. BEGIN
  464.   lst.Init(ApplList);
  465.   IF NOT OpenRexx() THEN
  466.     CloseRexx; END;
  467.  
  468. CLOSE
  469.   WHILE ApplList.head # NIL DO
  470.     edG.Arg[0] := ApplList.head(Application).name;
  471.     doApplClose;
  472.   END;
  473.   CloseRexx;
  474. END EdRexx.
  475.  
  476.